home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / sockets.c < prev    next >
C/C++ Source or Header  |  1992-10-06  |  15KB  |  599 lines
  1. /* ******************************************************************** */
  2. /* sockets.c         Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* Inter-processes communication                                    */
  5. /* ******************************************************************** */
  6.  
  7. #define PAUSE() 
  8.  
  9. /*
  10.  * Change Log:
  11.  *   Version 1, June 1990
  12.  */
  13.  
  14. static char *woo_woo = "WOO! WOO!"; /* To appease ncc */
  15.  
  16. #if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS))
  17.  
  18. #include "funcalls.h"
  19. #include "defs.h"
  20. #include "structs.h"
  21. #include "error.h"
  22. #include "global.h"
  23.  
  24. #include "calls.h"
  25. #include "modboot.h"
  26. #include "allocate.h"
  27. #include "modules.h"
  28.  
  29. #include "symboot.h"
  30. #include "syssockets.h"
  31. #include "sio.h"
  32. #include "class.h"
  33.  
  34. /*
  35.  
  36.  * Socket stuff... 
  37.  
  38.  */
  39.  
  40. /* Globals... */
  41.  
  42. SYSTEM_GLOBAL(char *,host_machine_name);
  43. SYSTEM_GLOBAL(Host *,host_machine_ref);
  44. SYSTEM_GLOBAL(LispObject,host_machine_lisp_name);
  45.  
  46. /* classes */
  47. static LispObject Socket;
  48. static LispObject Listener;
  49. /* metaclasses -- maybe use primitive class */
  50.  
  51. EUFUN_1( Fn_listernerp, obj)
  52. {
  53.   return((is_listener(obj) ? lisptrue : nil));
  54. }
  55. EUFUN_CLOSE
  56.  
  57. EUFUN_1( Fn_socketp, obj)
  58. {
  59.   return((is_socket(obj) ? lisptrue : nil));
  60. }
  61. EUFUN_CLOSE
  62.  
  63. EUFUN_0( Fn_make_listener)
  64. {
  65.   LispObject listener;
  66.   int length;
  67.   int port;
  68.  
  69.   listener = allocate_listener(stacktop);
  70.  
  71.   if ((listener->LISTENER.socket = socket(AF_INET,SOCK_STREAM,0)) < 0) 
  72.     CallError(stacktop,
  73.           "make-;istener: unable to make socket",nil,NONCONTINUABLE);
  74.  
  75.   /* Bind it to look for anything... */
  76.  
  77.   listener->LISTENER.name.sin_family = AF_INET;
  78.   listener->LISTENER.name.sin_addr.s_addr = INADDR_ANY;
  79.   listener->LISTENER.name.sin_port = 0;
  80.  
  81.   length = sizeof(SocketInName);
  82.  
  83.   if (bind(listener->LISTENER.socket,
  84.        (SocketName *) &(listener->LISTENER.name),
  85.        length) < 0)
  86.     CallError(stacktop,"make-listener: can't bind socket",nil,NONCONTINUABLE);
  87.  
  88.   if (getsockname(listener->LISTENER.socket,
  89.           (SocketName *) &(listener->LISTENER.name),
  90.           &length) < 0)
  91.     CallError(stacktop,
  92.           "make-listener: can't get socket data",nil,NONCONTINUABLE);
  93.  
  94.   listener->LISTENER.state = SOCKET_VIRGIN;
  95.  
  96.   listen(listener->LISTENER.socket,5); /* One step at a time... */
  97.  
  98.   lval_classof(listener) = Listener; 
  99.   return(listener);
  100. }
  101. EUFUN_CLOSE
  102.  
  103. EUFUN_0( Fn_make_socket)
  104. {
  105.   LispObject lispsock;
  106.  
  107.   lispsock = allocate_socket(stacktop);
  108.  
  109.   if ((lispsock->SOCKET.socket = socket(AF_INET,SOCK_STREAM,0)) < 0)
  110.     CallError(stacktop,
  111.           "make-socket: unable to make socket",nil,NONCONTINUABLE);
  112.  
  113.   lispsock->SOCKET.state = SOCKET_VIRGIN;
  114.   
  115.   lval_classof(lispsock) = Socket;
  116.  
  117.   return(lispsock);
  118. }
  119. EUFUN_CLOSE
  120.   
  121. EUFUN_1( Fn_listener_id, sock)
  122. {
  123.   LispObject data;
  124.  
  125.   if (!is_listener(sock))
  126.     CallError(stacktop,"listener-id: not a listener",sock,NONCONTINUABLE);
  127.  
  128.   if (sock->LISTENER.state != SOCKET_VIRGIN)
  129.     CallError(stacktop,"listener-id: socket not virgin ",sock,NONCONTINUABLE);
  130.  
  131.   /* Should lock it for parallel safety I suppose... */
  132.  
  133.   /* Build a list of host machine and port number... */
  134.  
  135.   if (ntohs(sock->LISTENER.name.sin_port) > 0x7ffffff)
  136.     CallError(stacktop,
  137.           "listener-id: port number overflow!",sock,NONCONTINUABLE);
  138.  
  139.   STACK(sock);
  140.  
  141.   data = (LispObject)
  142.          allocate_integer(stacktop,(int) ntohs(sock->LISTENER.name.sin_port));
  143.   EUCALLSET_2(data , Fn_cons, SYSTEM_GLOBAL_VALUE(host_machine_lisp_name),
  144.           data);
  145.  
  146.   return(data);
  147. }
  148. EUFUN_CLOSE
  149.  
  150. EUFUN_1( Fn_listen, sock)
  151. {
  152.   LispObject new;
  153.   int length;
  154.  
  155.   if (!is_listener(sock))
  156.     CallError(stacktop,"listen: not a listener",sock,NONCONTINUABLE);
  157.  
  158.   if (sock->LISTENER.state != SOCKET_VIRGIN)
  159.     CallError(stacktop,"listen: listener not virgin",sock,NONCONTINUABLE);
  160.  
  161.   /* All is cool... */
  162.  
  163.   sock->LISTENER.state = SOCKET_LISTENING;
  164.  
  165.   sock->LISTENER.state = SOCKET_VIRGIN;
  166.  
  167.   /* Give back a 'copy'... */
  168.  
  169.   new = allocate_socket(stacktop);
  170.   lval_classof(new) = Socket; 
  171.  
  172.   new->SOCKET.state = SOCKET_CONNECTED;
  173.  
  174.   length = sizeof(SocketInName);
  175.  
  176.   new->SOCKET.socket = accept(sock->SOCKET.socket,
  177.                   (SocketName *) &(new->SOCKET.name),
  178.                   &length);
  179.  
  180.   if (new->SOCKET.socket < 0)
  181.     CallError(stacktop,"listen: unable to accept connection"
  182.           ,sock,NONCONTINUABLE);
  183.  
  184.   /* All is cool I think... */
  185.  
  186.   return(new);
  187. }
  188. EUFUN_CLOSE
  189.  
  190. EUFUN_1( Fn_connect, data)
  191. {
  192.   LispObject sock;
  193.   LispObject hostname,port;
  194.   Host *hostptr;
  195.   SocketInName their_name;
  196.  
  197.   if (!is_cons(data))
  198.     CallError(stacktop,"connect: invalid socket data",data,NONCONTINUABLE);
  199.  
  200.   hostname = CAR(data); port = CDR(data);
  201.  
  202.   if (!is_symbol(hostname) || !is_fixnum(port))
  203.     CallError(stacktop,"connect: invalid data elts",data,NONCONTINUABLE);
  204.  
  205.   /* Hokay... */
  206.  
  207.   STACK_TMP(port);
  208.   STACK_TMP(hostname);
  209.   sock = allocate_socket(stacktop);
  210.   UNSTACK_TMP(hostname);
  211.   UNSTACK_TMP(port);
  212.   lval_classof(sock) = Socket; 
  213.  
  214.   if ((sock->SOCKET.socket = socket(AF_INET,SOCK_STREAM,0)) < 0)
  215.     CallError(stacktop,"connect: can't get socket",data,NONCONTINUABLE);
  216.  
  217.   hostptr = gethostbyname(hostname->SYMBOL.pname);
  218.  
  219.   if (hostptr == NULL)
  220.     CallError(stacktop,"connect: unknown host",hostname,NONCONTINUABLE);
  221.  
  222.   bcopy((char *) (hostptr->h_addr),
  223.     (char *) &(their_name.sin_addr),
  224.     hostptr->h_length);
  225.   their_name.sin_family = AF_INET;
  226.   their_name.sin_port = htons(intval(port));
  227.  
  228.   if (connect(sock->SOCKET.socket,
  229.           (SocketName *) &their_name,
  230.           sizeof(their_name)) < 0) 
  231.     CallError(stacktop,"socket-connect: can't connect",data,NONCONTINUABLE);
  232.  
  233.   /* All is cool (hopefully)... */
  234.  
  235.   sock->SOCKET.state = SOCKET_CONNECTED;
  236.  
  237.   return(sock);
  238. }
  239. EUFUN_CLOSE
  240.  
  241. EUFUN_1( Fn_close_listener, list)
  242. {
  243.   if (!is_listener(list))
  244.     CallError(stacktop,"close-listener: not a listeners",list,NONCONTINUABLE);
  245.  
  246.   if (list->LISTENER.state != SOCKET_VIRGIN)
  247.     CallError(stacktop,"close-listener: not virgin",list,NONCONTINUABLE);
  248.  
  249. #ifdef notdef
  250. /**/  These lines cause trouble on stardents...
  251. /**/  shutdown(list->LISTENER.socket,2);
  252. /**/
  253. /**/  close(list->LISTENER.socket);
  254. #endif
  255.   list->LISTENER.state = SOCKET_CLOSED;
  256.  
  257.  
  258.   return(nil);
  259. }
  260. EUFUN_CLOSE
  261.  
  262. EUFUN_1( Fn_close_socket, sock)
  263. {
  264.   if (!is_socket(sock))
  265.     CallError(stacktop,"close-socket: not a socket",sock,NONCONTINUABLE);
  266.  
  267.   if (sock->SOCKET.state != SOCKET_VIRGIN
  268.       && sock->SOCKET.state != SOCKET_CONNECTED)
  269.     CallError(stacktop,"close-socket: not virgin",sock,NONCONTINUABLE);
  270.  
  271.   shutdown(sock->SOCKET.socket,2);
  272.  
  273.   close(sock->SOCKET.socket);
  274.  
  275.   sock->SOCKET.state = SOCKET_CLOSED;
  276.  
  277.   return(nil);
  278. }
  279. EUFUN_CLOSE
  280.  
  281. EUFUN_2( Fn_socket_write, sock, form)
  282. {
  283.   if (!is_socket(sock))
  284.     CallError(stacktop,"socket-write: not a socket",sock,NONCONTINUABLE);
  285.  
  286.   if (sock->SOCKET.state != SOCKET_CONNECTED)
  287.     CallError(stacktop,
  288.           "socket-write: socket not connected",sock,NONCONTINUABLE);
  289.  
  290.   /* Set up the buffer... */
  291.  
  292.   BUFFER_FORM() = form;
  293.   BUFFER_PTR() = 0;
  294.  
  295.   /* Write form... */
  296.  
  297.   write_object(stacktop,form);
  298.   *(BUFFER()) = '\0';
  299.  
  300. /*  fprintf(stderr,"written: '%s'\n",BUFFER_START()); */
  301.  
  302.   /* OK, now flush the socket... */
  303.  
  304.   write(sock->SOCKET.socket,(char *) &(BUFFER_PTR()),sizeof(int));
  305.   write(sock->SOCKET.socket,BUFFER_START(),BUFFER_PTR());
  306.  
  307.   return(form);
  308. }
  309. EUFUN_CLOSE
  310.  
  311. #ifdef WITH_SYSTEMV_SOCKETS
  312.  
  313. #include <stropts.h>
  314. #include <poll.h>
  315.  
  316. EUFUN_1( Fn_socket_readable_p, sock)
  317. {
  318.   struct pollfd fds[1];
  319.   unsigned long nfds = 1;
  320.  
  321.   if (!is_socket(sock))
  322.     CallError(stacktop,"socket-readable-p: not a socket",sock,NONCONTINUABLE);
  323.  
  324.   if (sock->SOCKET.state != SOCKET_CONNECTED)
  325.     CallError(stacktop,"socket-readable-p: not connected",sock,NONCONTINUABLE);
  326.  
  327.   fds[0].fd = sock->SOCKET.socket;
  328.   fds[0].events = POLLIN;
  329.   fds[0].revents = NULL;
  330.  
  331.   if (poll(fds,nfds,0) < 0)
  332.     CallError(stacktop,"socket-readable-p: poll failed",sock,NONCONTINUABLE);
  333.  
  334.   if (fds[0].revents & POLLIN)
  335.     return(lisptrue);
  336.   else
  337.     return(nil);
  338. }
  339. EUFUN_CLOSE
  340.  
  341. EUFUN_1( Fn_listener_listenable_p, listener)
  342. {
  343.   struct pollfd fds[1];
  344.   unsigned long nfds = 1;
  345.  
  346.   if (!is_listener(listener))
  347.     CallError(stacktop,
  348.           "listener_listenable_p: not a listener",listener,NONCONTINUABLE);
  349.  
  350.   fds[0].fd = listener->SOCKET.socket;
  351.   fds[0].events = POLLIN;
  352.   fds[0].revents = NULL;
  353.  
  354.   if (poll(fds,nfds,0) < 0)
  355.     CallError(stacktop,
  356.           "socket-readable-p: poll failed",listener,NONCONTINUABLE);
  357.  
  358.   if (fds[0].revents & POLLIN)
  359.     return(lisptrue);
  360.   else
  361.     return(nil);
  362. }
  363. EUFUN_CLOSE
  364.  
  365. EUFUN_1( Fn_socket_writable_p, sock)
  366. {
  367.   struct pollfd fds[1];
  368.   unsigned long nfds = 1;
  369.  
  370.   if (!is_socket(sock))
  371.     CallError(stacktop,"socket-writable-p: not a socket",sock,NONCONTINUABLE);
  372.  
  373.   if (sock->SOCKET.state != SOCKET_CONNECTED)
  374.     CallError(stacktop,"socket-writable-p: not connected",sock,NONCONTINUABLE);
  375.  
  376.   fds[0].fd = sock->SOCKET.socket;
  377.   fds[0].events = POLLOUT;
  378.   fds[0].revents = NULL;
  379.  
  380.   if (poll(fds,nfds,0) < 0)
  381.     CallError(stacktop,"socket-writable-p: poll failed",sock,NONCONTINUABLE);
  382.  
  383.   if (fds[0].revents & POLLOUT)
  384.     return(lisptrue);
  385.   else
  386.     return(nil);
  387. }
  388. EUFUN_CLOSE
  389.  
  390. #else
  391.  
  392. /* BSD... */
  393.  
  394. #include <sys/time.h>
  395.  
  396. EUFUN_1( Fn_socket_readable_p, sock)
  397. {
  398.   fd_set mask;
  399.   struct timeval wait;
  400.  
  401.   if (!is_socket(sock))
  402.     CallError(stacktop,"socket-readable-p: not a socket",sock,NONCONTINUABLE);
  403.  
  404.   if (sock->SOCKET.state != SOCKET_CONNECTED)
  405.     CallError(stacktop,"socket-readable-p: not connected",sock,NONCONTINUABLE);
  406.  
  407.   /* Do a select with 0 timeout... */
  408.  
  409.   wait.tv_sec = 0;
  410.   wait.tv_usec = 0;
  411.  
  412.   FD_ZERO(&mask);
  413.   FD_SET(sock->SOCKET.socket,&mask);
  414.  
  415.   if (select(getdtablesize(),&mask,NULL,NULL,&wait) < 0)
  416.     CallError(stacktop,"socket-readable-p: select failed",sock,NONCONTINUABLE);
  417.  
  418.   if (FD_ISSET(sock->SOCKET.socket,&mask))
  419.     return(lisptrue);
  420.   else
  421.     return(nil);
  422.  
  423.   return(nil);
  424. }
  425. EUFUN_CLOSE
  426.  
  427. EUFUN_1( Fn_listener_listenable_p, listener)
  428. {
  429.   fd_set mask;
  430.   struct timeval wait;
  431.  
  432.   if (!is_listener(listener))
  433.     CallError(stacktop,
  434.           "socket-listenable-p: not a listener",listener,NONCONTINUABLE);
  435.  
  436.   /* Do a select with 0 timeout... */
  437.  
  438.   wait.tv_sec = 0;
  439.   wait.tv_usec = 0;
  440.  
  441.   FD_ZERO(&mask);
  442.   FD_SET(listener->LISTENER.socket,&mask);
  443.  
  444.   if (select(getdtablesize(),&mask,NULL,NULL,&wait) < 0)
  445.     CallError(stacktop,
  446.           "socket-readable-p: select failed",listener,NONCONTINUABLE);
  447.  
  448.   if (FD_ISSET(listener->LISTENER.socket,&mask))
  449.     return(lisptrue);
  450.   else
  451.     return(nil);
  452.  
  453.   return(nil);
  454. }
  455. EUFUN_CLOSE
  456.  
  457. EUFUN_1( Fn_socket_writable_p, sock)
  458. {
  459.   fd_set mask;
  460.   struct timeval wait;
  461.  
  462.   if (!is_socket(sock))
  463.     CallError(stacktop,
  464.           "socket-readable-p: not a socket",sock,NONCONTINUABLE);
  465.  
  466.   if (sock->SOCKET.state != SOCKET_CONNECTED)
  467.     CallError(stacktop,
  468.           "socket-readable-p: not connected",sock,NONCONTINUABLE);
  469.  
  470.   /* Do a select with 0 timeout... */
  471.  
  472.   wait.tv_sec = 0;
  473.   wait.tv_usec = 0;
  474.  
  475.   FD_ZERO(&mask);
  476.   FD_SET(sock->SOCKET.socket,&mask);
  477.  
  478.   if (select(getdtablesize(),NULL,&mask,NULL,&wait) < 0)
  479.     CallError(stacktop,"socket-readable-p: select failed",sock,NONCONTINUABLE);
  480.  
  481.   if (FD_ISSET(sock->SOCKET.socket,&mask))
  482.     return(lisptrue);
  483.   else
  484.     return(nil);
  485.  
  486.   return(nil);
  487.  
  488. }
  489. EUFUN_CLOSE
  490.  
  491. #endif
  492.  
  493. EUFUN_1( Fn_socket_read, sock)
  494. {
  495.   int len,ret;
  496.   LispObject obj;
  497.  
  498.   if (!is_socket(sock))
  499.     CallError(stacktop,"socket-read: not a socket",sock,NONCONTINUABLE);
  500.  
  501.   if (sock->SOCKET.state != SOCKET_CONNECTED)
  502.     CallError(stacktop,"socket-read: not connected",sock,NONCONTINUABLE);
  503.  
  504. #ifdef NOTDEFINED    /* Allow this call to block */
  505.   if (Fn_socket_readable_p(sock) == nil)
  506.     CallError(stacktop,"socket-read: socket unreadable",sock,NONCONTINUABLE);
  507. #endif
  508.  
  509.   /* Get the length... */
  510.  
  511.   if ( (ret = read(sock->SOCKET.socket,(char *) &len,sizeof(int))) == -1)
  512.     {
  513.       CallError(stacktop,
  514.         "socket-read: could not read socket",sock,NONCONTINUABLE);
  515.     }
  516.  
  517.   /* Read the data... */
  518.  
  519.   if ((ret = read(sock->SOCKET.socket,(char *) (BUFFER_START()),len)) == -1)
  520.     {
  521.       CallError(stacktop,
  522.         "socket-read: could not complete socket-read",
  523.         sock,NONCONTINUABLE);
  524.     }
  525.  
  526. /*  fprintf(stderr,"read: '%s'\n",BUFFER_START()); */
  527.  
  528.   *(BUFFER_START() + len) = '\0';
  529.   *(BUFFER_START() + len + 1) = '\n';
  530.  
  531.   /* Set up buffer... */
  532.  
  533.   BUFFER_PTR() = 0;
  534.  
  535.   obj = read_object(stacktop);
  536.  
  537.   return(obj);
  538. }
  539. EUFUN_CLOSE
  540.  
  541. /* *************************************************************** */
  542. /* Initialisation of this section                                  */
  543. /* *************************************************************** */
  544.  
  545.  
  546. #define SOCKETS_ENTRIES 15
  547. MODULE Module_sockets;
  548. LispObject Module_sockets_values[SOCKETS_ENTRIES];
  549.  
  550. void initialise_sockets(LispObject *stacktop)
  551. {
  552.   extern LispObject Standard_Class,Object, Primitive_Class;
  553.  
  554.   Socket = (LispObject) allocate_class(stacktop,NULL);
  555.   add_root(&Socket);
  556.   Listener = (LispObject) allocate_class(stacktop,NULL);    
  557.   add_root(&Listener);
  558.  
  559.   make_class(stacktop,Listener, "listener",Primitive_Class,Object, 0);
  560.   make_class(stacktop,Socket, "socket",Primitive_Class,Object, 0);  
  561.  
  562.   SYSTEM_INITIALISE_GLOBAL(char *,host_machine_name,NULL);
  563.   SYSTEM_INITIALISE_GLOBAL(Host *,host_machine_ref,NULL);
  564.   SYSTEM_INITIALISE_GLOBAL(LispObject,host_machine_lisp_name,NULL);
  565.   ADD_SYSTEM_GLOBAL_ROOT(host_machine_lisp_name);
  566.  
  567.   SYSTEM_GLOBAL_VALUE(host_machine_name) = (char *) malloc(64);
  568.   gethostname(SYSTEM_GLOBAL_VALUE(host_machine_name),64);
  569.  
  570.   SYSTEM_GLOBAL_VALUE(host_machine_lisp_name)
  571.     = (LispObject) get_symbol(stacktop,SYSTEM_GLOBAL_VALUE(host_machine_name));
  572.  
  573.   open_module(stacktop,
  574.           &Module_sockets,Module_sockets_values,"sockets",SOCKETS_ENTRIES);
  575.   
  576.  
  577.   (void) make_module_function(stacktop,"socketp",Fn_socketp,1);
  578.   (void) make_module_function(stacktop,"make-listener",
  579.                   Fn_make_listener,0);
  580.   (void) make_module_function(stacktop,"make-socket",
  581.                   Fn_make_socket,0);
  582.   (void) make_module_function(stacktop,"listener-id",Fn_listener_id,1);
  583.   (void) make_module_function(stacktop,"listen",Fn_listen,1);
  584.   (void) make_module_function(stacktop,"connect",Fn_connect,1);
  585.   (void) make_module_function(stacktop,"close-listener",Fn_close_listener,1);
  586.   (void) make_module_function(stacktop,"close-socket",Fn_close_socket,1);
  587.   (void) make_module_function(stacktop,"socket-write",Fn_socket_write,2);
  588.   (void) make_module_function(stacktop,"socket-read",Fn_socket_read,1);
  589.   (void) make_module_function(stacktop,"socket-readable-p",Fn_socket_readable_p,1);
  590.   (void) make_module_function(stacktop,"socket-writable-p",Fn_socket_writable_p,1);
  591.   (void) make_module_function(stacktop,"listener-listenable-p",Fn_listener_listenable_p,1);
  592.   (void) make_module_entry(stacktop,"listener",Listener);
  593.   (void) make_module_entry(stacktop,"socket",Socket);
  594.   close_module();
  595.  
  596. }
  597.  
  598. #endif
  599.